home *** CD-ROM | disk | FTP | other *** search
/ Commodore Disk User Volume 4 #11 / Commodore_Disk_User_Vol.4_11_1991_-.d64 / udg compressor (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  3KB  |  67 lines
  1. 1 poke53280,0:poke53281,0:printchr$(8):poke53272,20
  2. 2 print"[147]humpty software character set compressor"
  3. 3 print"(c) and written humpty damien marsh 1988"
  4. 4 print"for use by humpty software personal only"
  5. 5 print"char.set should already have been loaded"
  6. 6 print"what memory position does the set begin?"
  7. 7 gosub50:ifa<6000ora>53000or(a>40000anda<49000)ora/2048<>int(a/2048)then7
  8. 8 s=a:print"last char.in set is char.no. (inclusive)"
  9. 9 gosub50:ifa<2ora>255then9
  10. 10 l=a:print"scanning set for duplicates. please wait"
  11. 11 dimc(l),d(l),e(l):c(0)=256:e=0:fori=1tol:forj=0toi-1:f=0
  12. 12 fork=0to7:ifpeek(s+i*8+k)<>peek(s+j*8+k)thenf=1
  13. 13 next:onfgoto14:c(i)=j:j=i:goto15
  14. 14 c(i)=256:e=1
  15. 15 next:next:ife=0thenprint"sorry, there's no duplicates in char.set":goto49
  16. 16 print"scan complete. table of duplicates ready"
  17. 17 print"print table of duplicates on the screen?"
  18. 18 gosub51:on1-(a$="n")-(2*(a$="y"))goto18,19:f=1:gosub52
  19. 19 print"list table of duplicates to the printer?"
  20. 20 print"if 'y' then ensure that printer is ready"
  21. 21 gosub51:on1-(a$="n")-(2*(a$="y"))goto21,23:f=0:open1,4:cmd1:gosub52
  22. 22 printchr$(13)
  23. 23 close1:open3,3:cmd3:print"options: (q)uit now,(d)elete duplicates,"
  24. 24 print"[145](c)ompress charset. press (q),(d) or (c)"
  25. 25 gosub51:on((a$="q")*-1)+((a$="d")*-2)+((a$="c")*-3)+1goto25,49,26,34
  26. 26 print"number to fill deleted characters with ?"
  27. 27 gosub50:ifa<0ora>255then28
  28. 28 print"filling duplicates with the above number"
  29. 29 f=a:fori=0tol:ifc(i)<256thenforj=0to7:pokes+i*8+j,f:next
  30. 30 next:print"complete. duplicates are now all deleted"
  31. 31 fori=0tol:ifc(i)<256thend(i)=c(i):goto33
  32. 32 d(i)=i
  33. 33 next:goto43
  34. 34 print"removing duplicates and compressing set.":z=0:d(0)=0
  35. 35 z=z+1:d(z)=z:ifc(z)=256then35
  36. 36 j=z:fori=ztol:fork=0to7:poke14336+j*8+k,peek(14336+i*8+k):next
  37. 37 ifc(i)=256thend(i)=j:j=j+1:goto39
  38. 38 d(i)=d(c(i))
  39. 39 next:l1=j-1:print"complete.  number to fill excess chars ?"
  40. 40 gosub50:ifa<0ora>255then40
  41. 41 z=a:fori=s+l1*8tos+2047:pokei,z:next
  42. 42 print"complete. there are now"l1"chars used."
  43. 43 print"list old chars/new chars table to screen"
  44. 44 gosub51:on1-(a$="n")-(2*(a$="y"))goto44,45:f=1:gosub60
  45. 45 print"list old char/new char table to printer?"
  46. 46 gosub51:on1-(a$="n")-(2*(a$="y"))goto46,48:f=0:open1,4:cmd1:gosub60
  47. 47 printchr$(13):close1:close3:open3,3:cmd3
  48. 48 print"i suggest that you save your new set now"
  49. 49 print"[145][155]":end
  50. 50 gosub51:a=val(a$)-((a$="0")/10):on-(a=0)goto50:a=int(a):return
  51. 51 poke19,2:print"[145]>";:inputa$:poke19,0:print:return
  52. 52 print:gosub58
  53. 53 fori=0tol:printitab(20):ifc(i)=256thenprint"*****":goto55
  54. 54 printc(i)
  55. 55 ifpeek(214)=24andf=1thenwait198,1:poke198,0:gosub58
  56. 56 next:iff=1andpeek(214)>17thenwait198,1:poke198,0
  57. 57 return
  58. 58 iffthenprint"[147]";
  59. 59 print"character number"spc(4)"is identical to":print:return
  60. 60 print:gosub65
  61. 61 fori=0tol:printitab(20)d(i)
  62. 62 ifpeek(214)=24andf=1thenwait198,1:poke198,0:gosub65
  63. 63 next:iff=1andpeek(214)>19thenwait198,1:poke198,0
  64. 64 return
  65. 65 iffthenprint"[147]";
  66. 66 print"old charset"spc(9)"new charset":print:return
  67.